home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sendke1a / simkeys.frm (.txt) < prev    next >
Visual Basic Form  |  1999-03-10  |  9KB  |  281 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSimKeys 
  3.    Caption         =   "Send Keys and Mouse Events"
  4.    ClientHeight    =   4725
  5.    ClientLeft      =   3390
  6.    ClientTop       =   2400
  7.    ClientWidth     =   6870
  8.    LinkTopic       =   "Form1"
  9.    LockControls    =   -1  'True
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   4725
  12.    ScaleWidth      =   6870
  13.    Begin VB.CommandButton cmdClickMe 
  14.       Caption         =   "Click Me"
  15.       Height          =   435
  16.       Left            =   5520
  17.       TabIndex        =   9
  18.       Top             =   4140
  19.       Width           =   1275
  20.    End
  21.    Begin VB.Timer Timer1 
  22.       Left            =   5880
  23.       Top             =   3480
  24.    End
  25.    Begin VB.TextBox txtDelay 
  26.       Height          =   315
  27.       Left            =   5520
  28.       TabIndex        =   7
  29.       Text            =   "1"
  30.       Top             =   2880
  31.       Width           =   1215
  32.    End
  33.    Begin VB.TextBox txtTarget 
  34.       Height          =   315
  35.       Left            =   120
  36.       TabIndex        =   6
  37.       Top             =   420
  38.       Width           =   5235
  39.    End
  40.    Begin VB.CommandButton cmdCaptureActive 
  41.       Caption         =   "Capture Active"
  42.       Height          =   435
  43.       Left            =   5460
  44.       TabIndex        =   5
  45.       Top             =   1860
  46.       Width           =   1335
  47.    End
  48.    Begin VB.CommandButton cmdCaptureAll 
  49.       Caption         =   "Capture Screen"
  50.       Height          =   435
  51.       Left            =   5460
  52.       TabIndex        =   4
  53.       Top             =   1380
  54.       Width           =   1335
  55.    End
  56.    Begin VB.CommandButton cmdMouseMove 
  57.       Caption         =   "MyMouseMove"
  58.       Height          =   435
  59.       Left            =   5460
  60.       TabIndex        =   3
  61.       Top             =   900
  62.       Width           =   1335
  63.    End
  64.    Begin VB.CommandButton cmdSendKeys 
  65.       Caption         =   "MySendKeys"
  66.       Height          =   435
  67.       Left            =   5460
  68.       TabIndex        =   2
  69.       Top             =   420
  70.       Width           =   1335
  71.    End
  72.    Begin VB.TextBox txtSource 
  73.       Height          =   315
  74.       Left            =   120
  75.       TabIndex        =   1
  76.       Text            =   "Text to be entered by sendkeys"
  77.       Top             =   60
  78.       Width           =   6675
  79.    End
  80.    Begin VB.PictureBox picTest 
  81.       Height          =   3735
  82.       Left            =   120
  83.       ScaleHeight     =   3675
  84.       ScaleWidth      =   5175
  85.       TabIndex        =   0
  86.       Top             =   840
  87.       Width           =   5235
  88.    End
  89.    Begin VB.Label lblDelay 
  90.       Caption         =   "Delay (seconds)"
  91.       Height          =   255
  92.       Left            =   5520
  93.       TabIndex        =   8
  94.       Top             =   2580
  95.       Width           =   1155
  96.    End
  97. Attribute VB_Name = "frmSimKeys"
  98. Attribute VB_GlobalNameSpace = False
  99. Attribute VB_Creatable = False
  100. Attribute VB_PredeclaredId = True
  101. Attribute VB_Exposed = False
  102. Option Explicit
  103. Private Enum enOP
  104.     enOP_NO = 0
  105.     enOP_SendKeys = 1
  106.     enOP_SendMouse = 2
  107.     enOP_CaptScreen = 3
  108.     enOP_CaptWindow = 4
  109. End Enum
  110. Private menOperation As enOP
  111. Private mbIsWin9x As Boolean
  112. Private Sub Form_Load()
  113.     Dim lRet As Long
  114.     Dim tOSI As OSVERSIONINFO
  115.     tOSI.dwOSVersionInfoSize = Len(tOSI)
  116.     lRet = GetVersionEx(tOSI)
  117.     mbIsWin9x = CBool(tOSI.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
  118. End Sub
  119. Private Sub cmdSendKeys_Click()
  120.     Dim lDelay As Long
  121.     If menOperation <> enOP_NO Then
  122.         MsgBox "Wait for prior operation to finish"
  123.         Exit Sub
  124.     End If
  125.     lDelay = Val(txtDelay)
  126.     If lDelay = 0 Then
  127.         txtTarget.SetFocus
  128.         MySendKeys txtSource.Text
  129.     Else
  130.         menOperation = enOP_SendKeys
  131.         Timer1.Interval = lDelay * 1000
  132.         Timer1.Enabled = True
  133.     End If
  134. End Sub
  135. Private Sub cmdMouseMove_Click()
  136.     Dim lDelay As Long
  137.     If menOperation <> enOP_NO Then
  138.         MsgBox "Wait for prior operation to finish"
  139.         Exit Sub
  140.     End If
  141.     lDelay = Val(txtDelay)
  142.     If lDelay = 0 Then
  143.         MyMouseMove
  144.     Else
  145.         menOperation = enOP_SendMouse
  146.         Timer1.Interval = lDelay * 1000
  147.         Timer1.Enabled = True
  148.     End If
  149. End Sub
  150. Private Sub cmdCaptureAll_Click()
  151.     Dim lDelay As Long
  152.     If menOperation <> enOP_NO Then
  153.         MsgBox "Wait for prior operation to finish"
  154.         Exit Sub
  155.     End If
  156.     lDelay = Val(txtDelay)
  157.     If lDelay = 0 Then
  158.         MyCapture
  159.     Else
  160.         menOperation = enOP_CaptScreen
  161.         Timer1.Interval = lDelay * 1000
  162.         Timer1.Enabled = True
  163.     End If
  164. End Sub
  165. Private Sub cmdCaptureActive_Click()
  166.     Dim lDelay As Long
  167.     If menOperation <> enOP_NO Then
  168.         MsgBox "Wait for prior operation to finish"
  169.         Exit Sub
  170.     End If
  171.     lDelay = Val(txtDelay)
  172.     If lDelay = 0 Then
  173.         MyCapture True
  174.     Else
  175.         menOperation = enOP_CaptWindow
  176.         Timer1.Interval = lDelay * 1000
  177.         Timer1.Enabled = True
  178.     End If
  179. End Sub
  180. Private Sub cmdClickMe_Click()
  181.     MsgBox "Button has been clicked"
  182. End Sub
  183. Private Sub timer1_Timer()
  184.     Timer1.Enabled = False
  185.     Select Case menOperation
  186.         Case enOP_SendKeys:
  187.             txtTarget.SetFocus
  188.             MySendKeys txtSource.Text
  189.             
  190.         Case enOP_SendMouse:    MyMouseMove
  191.         Case enOP_CaptScreen:   MyCapture
  192.         Case enOP_CaptWindow:   MyCapture True
  193.     End Select
  194.     menOperation = enOP_NO
  195. End Sub
  196. ' Setting ovbActiveWnd to 1 causes capture of the active window only
  197. Public Sub MyCapture(Optional ByVal ovbActiveWnd As Boolean = False)
  198.     Dim lScanCodeALT As Long
  199.     Dim lSnapParam As Long
  200.     ' translate the virtual-key code into a scan code.
  201.     lScanCodeALT = MapVirtualKey(vbKeyMenu, 0)
  202.     cmdCaptureAll.Enabled = False
  203.     cmdCaptureActive.Enabled = False
  204.     Screen.MousePointer = vbHourglass
  205.     If ovbActiveWnd Then
  206.         keybd_event CByte(vbKeyMenu), CByte(lScanCodeALT), 0, 0
  207.         ' It seems necessary to let this key get processed before
  208.         ' taking the snapshot.
  209.     End If
  210.     ' Why does this work?  Who knows!
  211.     If (Not ovbActiveWnd) And mbIsWin9x Then lSnapParam = 1
  212.     DoEvents    ' These seem necessary to make it reliable
  213.     ' Take the snapshot
  214.     keybd_event CByte(vbKeySnapshot), CByte(lSnapParam), 0, 0
  215.     DoEvents
  216.     picTest.Picture = Clipboard.GetData(vbCFBitmap)
  217.     If ovbActiveWnd Then keybd_event CByte(vbKeyMenu), CByte(lScanCodeALT), KEYEVENTF_KEYUP, 0
  218.     cmdCaptureAll.Enabled = True
  219.     cmdCaptureActive.Enabled = True
  220.     Screen.MousePointer = vbDefault
  221. End Sub
  222. ' Try to move the mouse to click the "click me" button
  223. Public Sub MyMouseMove()
  224.     Dim tPOINT As POINTAPI
  225.     Dim lRet As Long
  226.     Dim lScreenX As Long
  227.     Dim lScreenY As Long
  228.     Dim lDestX As Long
  229.     Dim lDestY As Long
  230.     Dim lDistX As Long
  231.     Dim lDistY As Long
  232.     Dim lCurX As Long
  233.     Dim lCurY As Long
  234.     Dim bDone As Boolean
  235.     Dim lPtsPerX As Long
  236.     Dim lPtsPerY As Long
  237.     lScreenX = GetSystemMetrics(SM_CXSCREEN)
  238.     lScreenY = GetSystemMetrics(SM_CYSCREEN)
  239.     ' Get screen coordinates first
  240.     ' 10 by 10 pixels into the button
  241.     tPOINT.x = 10
  242.     tPOINT.y = 10
  243.     lRet = ClientToScreen(cmdClickMe.hwnd, tPOINT)
  244.     If lRet = 0 Then Exit Sub
  245.     ' transform to mousepoints
  246.     lDestX = (tPOINT.x * &HFFFF&) / lScreenX
  247.     lDestY = (tPOINT.y * &HFFFF&) / lScreenY
  248.     ' About how many mouse points per pixel
  249.     lPtsPerX = &HFFFF& / lScreenX
  250.     lPtsPerY = &HFFFF& / lScreenY
  251.     ' Now move it
  252.     Do
  253.         lRet = GetCursorPos(tPOINT)
  254.         
  255.         ' transform to mpousepoints
  256.         lCurX = (tPOINT.x * &HFFFF&) / lScreenX
  257.         lCurY = (tPOINT.y * &HFFFF&) / lScreenY
  258.         
  259.         ' calculate distance
  260.         lDistX = lDestX - lCurX
  261.         lDistY = lDestY - lCurY
  262.         
  263.         If (Abs(lDistX) < 2 * lPtsPerX) And _
  264.                 (Abs(lDistY) < 2 * lPtsPerY) Then
  265.             ' Close enough, go the rest of the way
  266.             lCurX = lDestX
  267.             lCurY = lDestY
  268.             bDone = True
  269.         Else
  270.             ' Move closer
  271.             lCurX = lCurX + Sgn(lDistX) * lPtsPerX * 2
  272.             lCurY = lCurY + Sgn(lDistY) * lPtsPerY * 2
  273.         End If
  274.         mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, lCurX, lCurY, 0, 0
  275.